perm filename EXPHD.FAI[IRC,LCS] blob sn#175505 filedate 1977-03-30 generic text, type T, neo UTF8
;MACROS TO MAKE FAIL EASIER

IFNDEF STANSW,<↓STANSW←←0>

	DEFINE CAT $(A,B){A$B}

	↓P←←17

	FOR @$ I←0,16
<	AC.$I←I
>

	$←400000

	.PLEVEL←←0
	.SLEVEL←←0

;SUBROUTINE DECLARATIONS.  MAKES MACROS FOR SYMBOLS REPRESENTING ARGUMENTS
	DEFINE NSUBR(NAME,X1,X2,X3,X4,X5,X6)
{	BEGIN NAME
	INTERN NAME
	XLIST
	GLOBAL .PLEVEL
	GLOBAL .SLEVEL
	.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL
	.PLEVEL←←.PLEVEL+1
IFDIF <><X1>{ DEFARG(X1,→.PLEVEL)
  .PLEVEL←.PLEVEL+1
 IFDIF <><X2>{ DEFARG(X2,→.PLEVEL)
   .PLEVEL←.PLEVEL+1
  IFDIF <><X3>{ DEFARG(X3,→.PLEVEL)
    .PLEVEL←.PLEVEL+1
   IFDIF <><X4>{ DEFARG(X4,→.PLEVEL)
     .PLEVEL←.PLEVEL+1
    IFDIF <><X5>{ DEFARG(X5,→.PLEVEL)
      .PLEVEL←.PLEVEL+1
     IFDIF <><X6>{ DEFARG(X6,→.PLEVEL)
       .PLEVEL←.PLEVEL+1
}}}}}}
LIST
↓NAME:	;}

;DEFINE AN ARGUMENT
	DEFINE DEFARG(NAME,LEVEL)
{ DEFINE NAME { LEVEL-.PLEVEL(17)}}

;END OF SUBROUTINE
	DEFINE SUBREND
{	.PLEVEL←←CAT(.SBR,→.SLEVEL)
	.SLEVEL←←.SLEVEL-1
	BLOCK 0
	BEND }

;GENERATE SUBROUTINE CALL (DOES THE RIGHT THING WITH SYMBOLIC ARGUEMENTS)
	DEFINE CALL(NAME,X1,X2,X3,X4,X5,X6){
	XLIST
	GLOBAL .SLEVEL,.PLEVEL
	.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL
IFDIF <><X1>{PUSH 17,X1↔.PLEVEL←.PLEVEL+1
 IFDIF <><X2>{PUSH 17,X2↔.PLEVEL←.PLEVEL+1
  IFDIF <><X3>{PUSH 17,X3↔.PLEVEL←.PLEVEL+1
   IFDIF <><X4>{PUSH 17,X4↔.PLEVEL←.PLEVEL+1
    IFDIF <><X5>{PUSH 17,X5↔.PLEVEL←.PLEVEL+1
     IFDIF <><X6>{PUSH 17,X6↔.PLEVEL←.PLEVEL+1
}}}}}}
	PUSHJ P,NAME
	.PLEVEL←←CAT(.SBR,→.SLEVEL)
	.SLEVEL←←.SLEVEL-1
	LIST}
;PUSH SOMETHING ONTO STACK
	DEFINE PUSHP(ARG)
<	PUSH P,ARG
	.PLEVEL←←.PLEVEL+1
>
	DEFINE POPP(ARG)
<	POP P,ARG
	.PLEVEL←←.PLEVEL-1
>
	DEFINE PUSHACS
<	PUSHJ P,PUSHIT↑
	GLOBAL .PLEVEL
	.PLEVEL←←.PLEVEL+20
>
	DEFINE POPACS
<	PUSHJ P,POPIT↑
	GLOBAL .PLEVEL
	.PLEVEL←←.PLEVEL-20
>

	DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}

;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.

IFNDEF POP0J
<	DEFINE POP0J <POPJ 17,>
	DEFINE POP1J<JRST POP1J.↑>
	DEFINE POP2J<JRST POP2J.↑>
	DEFINE POP3J<JRST POP3J.↑>
	DEFINE POP4J<JRST POP4J.↑>
	DEFINE POP5J<JRST POP5J.↑>
>

;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.

;	FOR @$ I←0,17{↓AC$I:0↔}
;	DEFINE SAVAC $(N){LAC[XWD 2,AC2]↔BLT AC$N}
;	DEFINE GETAC (N){LAC[XWD AC,2]↔BLT N}
	DEFINE ACCUMULATORS(LIST){ACPTR←←2
	FOR AC⊂(LIST)<AC←ACPTR
	 ACPTR←←ACPTR+1↔>}
	DEFINE DECLARE (LIST){
	FOR VARNAM⊂(LIST)<VARNAM: 0↔>}

;FATAL ERROR MESSAGE.

IFNDEF FATAL.
<	DEFINE FATAL(STR){PUSHJ 17,FATAL.↑↔JFCL [ASCIZ/STR/]}
>
IFNDEF WARN.
<	DEFINE WARN(STR){PUSHJ 17,WARN.↑↔JFCL [ASCIZ/STR/]}
>

;CHAIN TOGETHER INITIALIZING CODE
	DEFINE INITCODE
<IFAVL	.INITLINK
<	GLOBAL .INITLINK
	PUSHJ P,.+2
	JRST .INITLINK
 	↑.INITLINK←←.-2
;> ↑.INITLINK←←.
>

;CHAIN TOGETHER BIT TABLES
	DEFINE BITDEFS(BITS)
<IFNDEF .BTLNK < .BTLNK←←0 
;>	.BTLNK
	.BTLNK←←.BTLNK*1000000+$.
	.BTABL←←$.
	FOR BIT⊂(BITS)
<IFIDN <><BIT>< 0
;>	RADIX50 0,BIT
>	BLOCK =36+.BTABL-$.
>

	DEFINE TAIL
<DOINIT:
	IFDEF .INITLINK < PUSHJ P,.INITLINK
>	IFDEF .BTLNK < EXTERNAL $M
	MOVE [.BTLNK]
	SKIPE [$M]
	MOVEM $M+3
	POP0J
>>
;OPDEFS
;ONE OF BGB'S WHICH I LIKE
	OPDEF GO     [JRST]
;MAKE RAID KNOW THE FOLLOWING
	OPDEF HALT   [HALT]
	OPDEF JRSTF  [JRST 2,]

	DEFINE FIX
	<PRINTX FIX DOESN'T WORK OUTSIDE OF STANFORD ! >

	IODEND←←20000
	EXTERNAL JOBFF,JOBREL,JOBSA,JOBREN,JOBSYM,JOBDDT,JOBOPC

;Sigh...
	DEFINE IDBP
<	PRINTX Better change that IDBP to IDPB
	IDPB >